 ! Dynamic link library function for TASACS fortran modules
 ! This is the TASACS external interface for the windows world,
 ! letting you start the TASACS subroutines from i.e. delphi, c++, VBA etc.
 ! The DLL should further be packed into a component technology as activeX, to
 ! get seamless integration of fortran into clients. This layer is put outside the dll.
 ! Alternatively, compile with TASACS.f90 to make an exe file to run the console.
 ! Fortran dlls can be compiled with i.e. Lahey with -dll option.
 ! At unix you will only be able to watch it the old way through a system console.
 ! If you are using unix, you must omit this file and compile TASACS.f90 instead.

 
module XTASACS
   use OptimisationTypes
   implicit none
   type(TOptimisation), save :: Opt
   ! External Commands
   integer, parameter :: cmdCloseRun = 0
   integer, parameter :: cmdRunOpt = 1
   integer, parameter :: cmdResetOpt = 2
end module XTASACS



subroutine XRunOpt(Value)
   use XTASACS
   use optimisation 
   implicit none
   logical :: Value
   Value = RunOpt(Opt)
end subroutine XRunOpt


subroutine XObjFunc(Value)
   use XTASACS
   use Optimisation
   implicit none
   double precision :: Value
   Value = objfunc(Opt, .false.)
end subroutine XObjFunc


subroutine XExecute(CmdId, Param1)
   use XTASACS
   use Optimisation
   use Bootstrap
   implicit none
   integer, intent(in) :: CmdId
   integer, intent(in) :: Param1
   select case(CmdId)
      case (cmdCloseRun)
         call CloseRun(Opt)
      case (cmdResetOpt)
         call ResetOpt(Opt)
   end select
end subroutine XExecute


subroutine XLoadRun(ProjectDir, RunName)
   use XTASACS
   use index
   use Optimisation
   implicit none
   character(len=256), intent(in) :: ProjectDir
   character(len=256), intent(in) :: RunName
   logical :: res
   Opt%ProjectDir = ProjectDir
   Opt%RunName = RunName
   res = LoadRun(Opt) 
end subroutine XLoadRun


subroutine XSaveRun()
   use XTASACS
   use index
   use obsdata
   use parameter
   implicit none
   call WriteIndexData(Opt)
   call SaveParameters(Opt, .false.)
end subroutine XSaveRun


subroutine Xgetcategoryname(Cat, Res)
   use XTASACS
   use parameter
   use strutils
   implicit none
   integer, intent(in) :: Cat
   character(len=255), intent(out) :: Res
   if ((cFirstCategory <= Cat) .and. (Cat <= cLastCategory)) then
      Res = lrtrim(c_MetaParamSetup(Cat)%Text)
   else
      write (Res, *) Cat, " not supported"
   endif
end subroutine Xgetcategoryname



subroutine XgetIndexInputStockTitle(StockTitle)
   use XTASACS
   implicit none
   character(len = 256) :: StockTitle
   StockTitle = Opt%IndexInput%StockTitle
end subroutine XgetIndexInputStockTitle


subroutine XsetIndexInputStockTitle(StockTitle)
   use XTASACS
   implicit none
   character(len = 256) :: StockTitle
   Opt%IndexInput%StockTitle = StockTitle
end subroutine XsetIndexInputStockTitle


subroutine XGetRunProp(Prop, RetVal)
   use XTASACS
   use index
   implicit none
   integer, intent(in) :: Prop
   double precision, intent(out) :: RetVal
   select case(Prop)
      case(propProcessType) 
         RetVal = Opt%IndexInput%ProcessType
      case(propSearchRoutine) 
         RetVal = Opt%IndexInput%SearchRoutine
      case(propModelType) 
         RetVal = Opt%IndexInput%ModelType
      case(propISVPAControlType) 
         RetVal = Opt%IndexInput%ISVPAControlType
      case(propPlusGroupMethod) 
         RetVal = Opt%IndexInput%PlusGroupMethod
      case(propFirstYear) 
         RetVal = Opt%IndexInput%FirstYear
      case(propLastYear) 
         RetVal = Opt%IndexInput%LastYear
      case(propLastCatchYear) 
         RetVal = Opt%IndexInput%LastCatchYear
      case(propFirstAge) 
         RetVal = Opt%IndexInput%FirstAge
      case(propLastAge) 
         RetVal = Opt%IndexInput%LastAge
      case(propFirstRefAge) 
         RetVal = Opt%IndexInput%FirstRefAge
      case(propLastRefAge) 
         RetVal = Opt%IndexInput%LastRefAge
      case(propNumMedianElms) 
         RetVal = Opt%IndexInput%NumMedianElms
      case(propGammaShape) 
         RetVal = 0.0d0
      case(propNumFleetIndices) 
         RetVal = NumFleetIndices(Opt%IndexInput)
      case(propNumSSBIndices) 
         RetVal = NumSSBIndices(Opt%IndexInput)
      case(propNumBiomassIndices) 
         RetVal = NumBiomassIndices(Opt%IndexInput)
      case(propNumStages) 
         RetVal = Opt%IndexInput%NumStages
      case(propSSBFracF) 
         RetVal = Opt%IndexInput%SSBFracF
      case(propSSBFracM) 
         RetVal = Opt%IndexInput%SSBFracM
      case(propRunStage) 
         RetVal = Opt%Loc%Stage
      case(propRunIter) 
         RetVal = Opt%Loc%Iter
      case(propRunDelta) 
         RetVal = Opt%Loc%Delta
      case(propRunObjFunc) 
         RetVal = Opt%Loc%ObjFunc
      case(propRunNumParam)
         RetVal = size(Opt%pactive)
      case(propProgramVersion)
         RetVal = 1.1d0
      case default
         RetVal = 0d0
   end select
end subroutine XGetRunProp


subroutine XSetRunProp(Prop, Value)
   use XTASACS
   use index
   implicit none
   integer :: Prop, DataSourceType, S, NMax, N
   double precision ::  Value
   select case(Prop)
      case(propProcessType) 
         Opt%IndexInput%ProcessType = anint(Value)
      case(propSearchRoutine) 
         Opt%IndexInput%SearchRoutine = anint(Value)
      case(propModelType) 
         Opt%IndexInput%ModelType = anint(Value)
      case(propISVPAControlType) 
         Opt%IndexInput%ISVPAControlType = anint(Value)
      case(propPlusGroupMethod) 
         Opt%IndexInput%PlusGroupMethod = anint(Value)
      case(propFirstYear) 
         Opt%IndexInput%FirstYear = anint(Value)
      case(propLastYear) 
         Opt%IndexInput%LastYear = anint(Value)
      case(propLastCatchYear) 
         Opt%IndexInput%LastCatchYear = anint(Value)
      case(propFirstAge) 
         Opt%IndexInput%FirstAge = anint(Value)
      case(propLastAge) 
         Opt%IndexInput%LastAge = anint(Value)
      case(propFirstRefAge) 
         Opt%IndexInput%FirstRefAge = anint(Value)
      case(propLastRefAge) 
         Opt%IndexInput%LastRefAge = anint(Value)
      case(propNumMedianElms) 
         Opt%IndexInput%NumMedianElms = anint(Value)
      case(propGammaShape) 
         ;
      case(propNumFleetIndices, propNumSSBIndices, propNumBiomassIndices) 
         DataSourceType = Prop - propNumFleetIndices + 1 
         S = size(Opt%IndexInput%DataSources(DataSourceType)%Elm)
         if (S /= anint(Value)) then
            ! Reallocate
            if(associated(Opt%IndexInput%DataSources(DataSourceType)%Elm)) then
               deallocate(Opt%IndexInput%DataSources(DataSourceType)%Elm)
            endif
            N = anint(value)
            allocate(Opt%IndexInput%DataSources(DataSourceType)%Elm(0 : N - 1))
         endif
      case(propNumStages) 
         Opt%IndexInput%NumStages = anint(Value)
      case(propSSBFracF) 
         Opt%IndexInput%SSBFracF = Value
      case(propSSBFracM) 
         Opt%IndexInput%SSBFracM = Value
      case(propRunStage) 
         Opt%Loc%Stage = anint(Value)
   end select
end subroutine XSetRunProp


subroutine XGetRunPropStr(Prop, RetVal)
   use XTASACS
   use index
   implicit none
   integer, intent(in) :: Prop
   character(len = 256), intent(out) :: RetVal
   select case(Prop)
      case(propCaTonFile : propBiomassWeightFile)
         RetVal = Opt%IndexInput%DataFiles(odCaTon + (Prop - propCaTonFile))
      case(propParamIn) 
         RetVal = Opt%IndexInput%InParamFileName
      case(propParamOutFile : propRetroRecruitFile)
         RetVal = Opt%IndexInput%OutFiles(roParamOut + (Prop - propParamOutFile))
   end select
end subroutine XGetRunPropStr


subroutine XSetRunPropStr(Prop, Value)
   use XTASACS
   use index
   implicit none
   integer :: Prop
   character(len = 256) ::  Value
   select case(Prop)
      case(propCaTonFile : propBiomassWeightFile)
         Opt%IndexInput%DataFiles(odCaTon + (Prop - propCaTonFile)) = Value
      case(propParamIn) 
         Opt%IndexInput%InParamFileName = Value
      case(propParamOutFile : propRetroRecruitFile)
         Opt%IndexInput%OutFiles(roParamOut + (Prop - propParamOutFile)) = Value
   end select
end subroutine XSetRunPropStr


subroutine XGetDataSource(DataSource, DataSourceIndex, FProp, MProp, ObjType, Weight, My, PlusGroupCode, BootType, Sigma, BootFile)
   use XTASACS
   use ObsData
   implicit none
   integer, intent(in) :: DataSource, DataSourceIndex
   integer, intent(out) :: ObjType
   double precision, intent(out) :: FProp, MProp, Weight, My, Sigma
   integer, intent(out) :: PlusGroupCode
   integer, intent(out) :: BootType
   character(len=8), intent(out) :: BootFile
   type(TDataSource), pointer :: pDataSource
   pDataSource => GetDataSource(Opt, DataSource, DataSourceIndex)
   if (associated(pDataSource)) then
      FProp = pDataSource%FProp 
      MProp = pDataSource%MProp 
      ObjType = pDataSource%ObjType
      Weight = pDataSource%Weight
      My = pDataSource%My
      PlusGroupCode = pDataSource%PlusGroupCode
      BootType = pDataSource%BootType  
      Sigma = pDataSource%Sigma
      BootFile = pDataSource%BootFile 
   endif
end subroutine XGetDataSource


subroutine XSetDataSource(DataSource, DataSourceIndex, FProp, MProp, ObjType, Weight, My, PlusGroupCode, BootType, Sigma, BootFile)
   use XTASACS
   use ObsData
   implicit none
   integer, intent(in) :: DataSource, DataSourceIndex
   integer, intent(in) :: ObjType
   double precision, intent(in) :: FProp, MProp, Weight, My, Sigma
   integer, intent(in) :: PlusGroupCode
   integer, intent(in) :: BootType
   character(len=8), intent(in) :: BootFile
   type(TDataSource), pointer :: pDataSource
   pDataSource => GetDataSource(Opt, DataSource, DataSourceIndex)
   if (associated(pDataSource)) then
      pDataSource%FProp = FProp
      pDataSource%MProp = MProp 
      pDataSource%ObjType = ObjType
      pDataSource%Weight = Weight 
      pDataSource%My = My 
      pDataSource%PlusGroupCode = PlusGroupCode
      pDataSource%BootType = BootType
      pDataSource%Sigma = Sigma
      pDataSource%BootFile = BootFile
   endif
end subroutine XSetDataSource

! ------------------------------------
! Parameter element


subroutine XGetParamElmValue(Cat, Idx, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Cat, Idx, Year, Age
   type(TParamElm), pointer :: ParamElm
   ParamElm => GetParamElm(Opt, Cat, Idx, Year, Age, .true.)
   if(associated(ParamElm)) then
      Value = ParamElm%Value
   endif
end subroutine XGetParamElmValue


subroutine XSetParamElmValue(Cat, Idx, Year, Age, V)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Idx, Year, Age
   double precision :: V
   call SetPValue(Opt, Cat, Idx, Year, Age, V)
end subroutine XSetParamElmValue


subroutine XGetParamElmFlag(Cat, Idx, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Value
   integer :: Cat, Idx, Year, Age
   Value = PFlag(Opt, Cat, Idx, Year, Age)
end subroutine XGetParamElmFlag


subroutine XSetParamElmFlag(Cat, Idx, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Idx, Year, Age, Value
   type(TParamElm), pointer :: ParamElm
   ParamElm => GetParamElm(Opt, Cat, Idx, Year, Age, .true.)
   if(associated(ParamElm)) then
      ParamElm%Flag = Value
   endif
end subroutine XSetParamElmFlag


subroutine XGetParamElmDescr(Cat, Idx, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Idx, Year, Age
   character(len = c_ParamElmDescrLen) :: Value
   type(TParamElm), pointer :: ParamElm
   ParamElm => GetParamElm(Opt, Cat, Idx, Year, Age, .true.)
   if(associated(ParamElm)) then
      Value = ParamElm%Descr
   endif
end subroutine XGetParamElmDescr


subroutine XSetParamElmDescr(Cat, Idx, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Idx, Year, Age
   character(len = c_ParamElmDescrLen) :: Value
   type(TParamElm), pointer :: ParamElm
   if(associated(ParamElm)) then
      ParamElm => GetParamElm(Opt, Cat, Idx, Year, Age, .true.)
      ParamElm%Descr = Value
   endif
end subroutine XSetParamElmDescr


subroutine XGetN(Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Year, Age
   if (associated(Opt%PopModel)) then
      Value = Opt%PopModel%Nay(Year, Age)
   end if
end subroutine XGetN


subroutine XGetF(Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Year, Age
   if (associated(Opt%PopModel)) then
      Value = Opt%PopModel%Fay(Year, Age)
   end if
end subroutine XGetF


subroutine XGetM(Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Year, Age
   if (associated(Opt%PopModel)) then
      Value = Opt%PopModel%May(Year, Age)
   end if
end subroutine XGetM


subroutine XGetActiveParamValue(Idx, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Idx
   double precision :: Value
   Value = Opt%pactive(Idx)%Value
end subroutine XGetActiveParamValue


subroutine XSetActiveParamValue(Idx, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Idx
   double precision :: Value
   call SetPValueEx(Opt%pactive(Idx), Value)
end subroutine XSetActiveParamValue


subroutine XGetDataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx 
   integer, intent(out) :: FirstYear, LastYear, FirstAge, LastAge
   type(TObservedData), pointer :: pVar
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   FirstYear = pVar%FirstYear
   LastYear = pVar%FirstYear + pVar%NumYears - 1
   FirstAge = pVar%FirstAge
   if (FirstAge == -1) then
      LastAge = -1
   else
      LastAge = pVar%FirstAge + pVar%NumAges - 1
   endif
end subroutine XGetDataSourceDimensions


subroutine XSetDataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge)
   use XTASACS
   use parameter
   use ObsData
   implicit none
   integer, intent(in) :: Cat, Idx, FirstYear, LastYear, FirstAge, LastAge
   integer :: Num_Years, Num_Ages
   type(TObservedData), pointer :: pVar
   logical :: DimChanged 
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   Num_Years = LastYear - FirstYear + 1
   Num_Ages = LastAge - FirstAge + 1 
   
   DimChanged = &
      (pVar%FirstYear /= FirstYear) .or. &
      (pVar%NumYears /=  Num_Years) .or. &
      (pVar%FirstAge /= FirstAge) .or. &
      (pVar%NumAges /=  Num_Ages)
   pVar%FirstYear = FirstYear
   pVar%NumYears =  Num_Years
   pVar%FirstAge = FirstAge 
   pVar%NumAges = Num_Ages
   if (DimChanged) then
      pVar%FirstYear = FirstYear
      pVar%NumYears =  Num_Years
      pVar%FirstAge = FirstAge 
      pVar%NumAges = Num_Ages
      call AllocateObservedData(pVar)
   endif
end subroutine XSetDataSourceDimensions


subroutine XGetDataSourceValue(Cat, Idx, iYear, iAge, Value)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx, iYear, iAge
   double precision, intent(out) :: Value
   type(TObservedData), pointer :: pVar
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   Value = pVar%Obs(iYear, iAge)
end subroutine XGetDataSourceValue


subroutine XSetDataSourceValue(Cat, Idx, iYear, iAge, Value)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx, iYear, iAge
   double precision, intent(in) :: Value
   type(TObservedData), pointer :: pVar
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   pVar%Obs(iYear, iAge) = Value
end subroutine XSetDataSourceValue


subroutine XSaveObsData()
   use XTASACS
   use ObsData
   implicit none
   call WriteObsData(Opt)
end subroutine XSaveObsData

